home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / smlltalk / smtk_11.zoo / Bag.st < prev    next >
Text File  |  1990-05-26  |  5KB  |  183 lines
  1. "======================================================================
  2. |
  3. |   Bag Method Definitions
  4. |
  5.  ======================================================================"
  6.  
  7.  
  8. "======================================================================
  9. |
  10. | Copyright (C) 1988, 1989, 1990 Free Software Foundation, Inc.
  11. | Written by Steve Byrne.
  12. |
  13. | This file is part of GNU Smalltalk.
  14. |
  15. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  16. | under the terms of the GNU General Public License as published by the Free
  17. | Software Foundation; either version 1, or (at your option) any later version.
  18. | 
  19. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  20. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  21. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  22. | details.
  23. | 
  24. | You should have received a copy of the GNU General Public License along with
  25. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  26. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  27. |
  28.  ======================================================================"
  29.  
  30.  
  31. "
  32. |     Change Log
  33. | ============================================================================
  34. | Author       Date       Change 
  35. | sbyrne     25 Apr 89      created.
  36. |
  37. "
  38.  
  39. Collection subclass: #Bag
  40.        instanceVariableNames: 'contents'
  41.        classVariableNames: ''
  42.        poolDictionaries: ''
  43.        category: nil.
  44.  
  45. Bag comment:
  46. 'My instances are unordered collections of objects.  You can think
  47. of me as a set with a memory; that is, if the same object is added to me
  48. twice, then I will report that that element has been stored twice.'!
  49.  
  50.  
  51. !Bag class methodsFor: 'basic'!
  52.  
  53. new
  54.     ^super new initContents
  55. !!
  56.  
  57.  
  58.  
  59. !Bag methodsFor: 'Adding to a collection'!
  60.  
  61. add: newObject withOccurrences: anInteger
  62.     contents at: newObject
  63.          put: (self occurrencesOf: newObject) + anInteger.
  64.     ^newObject
  65. !
  66.  
  67. add: newObject
  68.     self add: newObject withOccurrences: 1.
  69.     ^newObject 
  70. !
  71.  
  72. at: index
  73.     self error: 'at: is not allowed for a Bag'
  74. !
  75.  
  76. at: index put: value
  77.     self error: 'at:put: is not allowed for a Bag'
  78. !!
  79.  
  80.  
  81.  
  82. !Bag methodsFor: 'Removing from a collection'!
  83.  
  84. remove: oldObject ifAbsent: anExceptionBlock
  85.     | count |
  86.     "Remove oldObject from the collection and return it.  Since we're using
  87.     a dictionary, we need decrement the value until it's zero, in which case
  88.     we can then remove the object from the dictionary"
  89.     count _ self occurrencesOf: oldObject.
  90.     count = 0 ifTrue: [ ^anExceptionBlock value ].
  91.     count = 1 ifTrue: [ contents removeKey: oldObject ]
  92.               ifFalse: [ contents at: oldObject
  93.                                 put: count - 1 ].
  94.     ^oldObject
  95. !!
  96.  
  97.  
  98.  
  99. !Bag methodsFor: 'testing collections'!
  100.  
  101. occurrencesOf: anObject
  102.     ^contents at: anObject ifAbsent: [ ^0 ]
  103. !
  104.  
  105. size
  106.     | count |
  107.     count _ 0.
  108.     contents do: [ :element | count _ count + element ].
  109.     ^count
  110. !
  111.  
  112. hash
  113.     ^contents hash
  114. !
  115.  
  116. = aBag
  117.     contents keysDo:
  118.         [ :aKey | contents occurrencesOf: aKey = aBag occurrencesOf: aKey
  119.                 ifFalse: [ ^false ] ].
  120.     ^true
  121. !!
  122.  
  123.  
  124.  
  125. !Bag methodsFor: 'enumerating the elements of a collection'!
  126.  
  127. do: aBlock
  128.     "Perform the block for all members in the collection.  For Bags, we need
  129.     to go through the contents dictionary, and perform the block for as many
  130.     occurrences of the objects as there are."
  131.     contents associationsDo:
  132.       [ :assoc |  assoc value timesRepeat: [ aBlock value: assoc key ] ]
  133. !!
  134.  
  135.  
  136.  
  137. !Bag methodsFor: 'printing'!
  138.  
  139. printOn: aStream
  140.     | firstTime |
  141.     aStream nextPutAll: self classNameString.
  142.     aStream nextPutAll: ' ('.
  143.     firstTime _ true.
  144.     contents associationsDo:
  145.       [ :assoc | firstTime ifTrue: [ firstTime _ false ]
  146.                              ifFalse: [ aStream nextPut: Character space ].
  147.                  assoc key storeOn: aStream.
  148.          aStream nextPut: $,.
  149.          assoc value storeOn: aStream ].
  150.     aStream nextPut: $)
  151. !!
  152.  
  153.  
  154.  
  155. !Bag methodsFor: 'storing'!
  156.  
  157. storeOn: aStream
  158.     | noElements |
  159.     aStream nextPut: $(.
  160.     aStream nextPutAll: self classNameString.
  161.     aStream nextPutAll: ' new'.
  162.     noElements _ true.
  163.     contents associationsDo:
  164.       [ :assoc | aStream nextPutAll: ' add: '.
  165.                  assoc key storeOn: aStream.
  166.          aStream nextPutAll: ' withOccurrences: '.
  167.          assoc value storeOn: aStream.
  168.          aStream nextPut: $;.
  169.          noElements _ false ].
  170.     noElements ifFalse: [ aStream nextPutAll: '; yourself' ].
  171.     aStream nextPut: $)
  172. !!
  173.  
  174.  
  175.  
  176. !Bag methodsFor: 'private'!
  177.  
  178. initContents
  179.     contents _ Dictionary new
  180.  
  181. !!
  182.  
  183.